home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Libraries / SAT 2.4.0 / SAT / Add-ons / Graphic effects / MiscGraphics.p < prev    next >
Encoding:
Text File  |  1997-03-03  |  10.6 KB  |  395 lines  |  [TEXT/PJMM]
  1. {Miscellaneous utility routines that I developed while writing Solitaire House,}
  2. {mostly rather simple graphic effects.}
  3.  
  4. unit MiscGraphics;
  5.  
  6. interface
  7.  
  8.     uses
  9. {$ifc UNDEFINED THINK_PASCAL}
  10.         Types, QuickDraw, Events, Windows, Dialogs, Fonts, DiskInit, TextEdit, Traps,{}
  11.         Memory, SegLoad, Scrap, ToolUtils, OSUtils, Menus, Resources, StandardFile,{}
  12.         GestaltEqu, Files, Errors, Devices, QuickDrawText, 
  13. {$endc}
  14.         SAT;
  15.  
  16. {*** Some QuickDraw-related utilities: ***}
  17.  
  18.     function MakeRGBColor (r, g, b: Integer): RGBColor;
  19.     function RectWidth (r: Rect): integer;
  20.     function RectHeight (r: Rect): integer;
  21.  
  22. {Is smallR completely within bigR?}
  23.     function RectInsideRect (smallR, bigR: Rect): Boolean;
  24. {Center the Rect s1R on s2R}
  25.     function CenterRectInRect (s1R: Rect; s2R: Rect): Rect;
  26.  
  27. {Draw a string centered withing the box.}
  28.     procedure StringCenter (aString: Str255; box: Rect; truncate: Boolean; shadow: Integer);
  29.  
  30. {Wipes for using as transitions after changing gSAT.offScreen.}
  31.     procedure WipeIn (ticks: Longint);
  32.     procedure WipeOut (ticks: Longint);
  33.  
  34. {Copy the contents of one SATPort to another.}
  35.     procedure CopyScreen (fromScreen, toScreen: SATPort);
  36.  
  37. {Make a zoom animation}
  38.     procedure ZoomRects (fromRect, toRect: Rect);
  39.  
  40. {*** A face manipulation routines. ***}
  41.  
  42. {Copy srcFace to destFace. If destFace is nil, a new face is created, otherwise srcFace is}
  43. {copied to the existing dstFace.}
  44.     procedure SATDupFace (var destFace: FacePtr; srcFace: FacePtr);
  45.  
  46. {*** Pattern and cursor utilities. ***}
  47.  
  48. {These pattern utilities replaces the old ones in the SAT lib. These are much easier to use}
  49. {and just as compatible. The point with them is to have glue routies that make it really}
  50. {easy to stay compatible with all old Macs, even old MacPlusses!}
  51.  
  52.     function SATGetPattern (patID: Integer): PixPatHandle;
  53.     procedure SATForePattern (pat: PixPatHandle);
  54.     procedure SATBackPattern (pat: PixPatHandle);
  55.     procedure SATFillRect (r: Rect; pat: PixPatHandle);
  56.     procedure SATDisposePattern (pat: PixPatHandle);
  57.  
  58.     function SATGetCursor (id: Integer): CursHandle;
  59.     procedure SATSetCursor (curs: CursHandle);
  60.     procedure SATDisposeCursor (curs: CursHandle);
  61.  
  62. implementation
  63.  
  64.     function MakeRGBColor (r, g, b: Integer): RGBColor;
  65.     begin
  66.         MakeRGBColor.red := r;
  67.         MakeRGBColor.green := g;
  68.         MakeRGBColor.blue := b;
  69.     end;
  70.  
  71.     function RectWidth (r: Rect): integer;
  72.     begin
  73.         RectWidth := r.right - r.left;
  74.     end;
  75.     function RectHeight (r: Rect): integer;
  76.     begin
  77.         RectHeight := r.bottom - r.top;
  78.     end;
  79.  
  80.     function RectInsideRect (smallR, bigR: Rect): Boolean;
  81.     begin
  82.         RectInsideRect := false;
  83.         if smallR.left >= bigR.left then
  84.             if smallR.top >= bigR.top then
  85.                 if smallR.right <= bigR.right then
  86.                     if smallR.bottom <= bigR.bottom then
  87.                         RectInsideRect := true;
  88.     end; {RectInsideRect}
  89.  
  90.     function CenterRectInRect (s1R: Rect; s2R: Rect): Rect;
  91.         var
  92.             dx, dy: Integer;
  93.             dR: Rect;
  94.     begin
  95.         dx := RectWidth(s1R);
  96.         dy := RectHeight(s1R);
  97.  
  98.         dR.left := s2R.left + BSR(RectWidth(s2R), 1) - BSR(dx, 1);
  99.         dR.top := s2R.top + BSR(RectHeight(s2R), 1) - BSR(dy, 1);
  100.         dR.right := dR.left + dx;
  101.         dR.bottom := dR.top + dy;
  102.         CenterRectInRect := dR;
  103.     end; {CenterRectInRect}
  104.  
  105.  
  106.     procedure StringCenter (aString: Str255; box: Rect; truncate: Boolean; shadow: Integer);
  107.         var
  108.             finf: FontInfo;
  109.             savePt: Point;
  110.             saveCol, saveCol2, col: RGBColor;
  111.             hpos, vpos: integer;
  112.             oldPen: PenState;
  113.     begin
  114. {Cut it down to fit!}
  115.         if truncate then
  116.             if StringWidth(aString) > (box.right - box.left) then
  117.                 repeat
  118.                     aString[0] := char(ord(aString[0]) - 1);
  119.                     aString[ord(aString[0])] := '…';
  120.                 until (StringWidth(aString) <= (box.right - box.left)) or (length(aString) < 2);
  121.  
  122.         GetFontInfo(finf);
  123.  
  124. {Vertically: Center on the box.}
  125.         if shadow <> 0 then
  126.             vpos := box.top + (box.bottom - box.top - (finf.ascent + finf.descent + finf.leading + shadow)) div 2 + finf.leading + finf.ascent
  127.         else
  128.             vpos := box.top + (box.bottom - box.top - (finf.ascent + finf.descent + finf.leading)) div 2 + finf.leading + finf.ascent;
  129. {Horizontally: The left edge of the box plus half.}
  130.         hpos := (box.right - StringWidth(aString)) div 2 + box.left div 2;
  131.         MoveTo(hpos, vpos);
  132.  
  133.         if shadow <> 0 then
  134.             begin
  135.                 GetPen(savePt);
  136.                 Move(shadow, shadow);
  137.                 if gSAT.initDepth > 1 then
  138.                     GetForeColor(saveCol);
  139.                 ForeColor(blackCOlor);
  140.                 DrawString(aString);
  141.                 MoveTo(savePt.h, savePt.v);
  142.                 if gSAT.initDepth > 1 then
  143.                     RGBForeColor(saveCol);
  144.             end;
  145.         DrawString(aString);
  146.     end; {StringCenter}
  147.  
  148.  
  149.     procedure WipeIn (ticks: Longint);
  150.         var
  151.             i: Integer;
  152.             reg1, reg2: RgnHandle;
  153.             r1, r2: Rect;
  154.             startTicks, amount: Longint;
  155.         const
  156.             kWipeSteps = 10;
  157.     begin
  158.         SATSetPortScreen;
  159.         reg1 := NewRgn;
  160.         reg2 := NewRgn;
  161.         startTicks := TickCount;
  162.         r1 := gSAT.offScreen.port^.portRect;
  163.         repeat
  164.             amount := TickCount - startTicks;
  165.             if amount > ticks then
  166.                 amount := ticks;
  167.  
  168.             r2.left := amount * Longint(gSAT.offSizeH) div 2 div ticks;
  169.             r2.right := gSAT.offSizeH - r2.left;
  170.             r2.top := amount * Longint(gSAT.offSizeV) div 2 div ticks;
  171.             r2.bottom := gSAT.offSizeV - r2.top;
  172.  
  173.             RectRgn(reg1, r1);
  174.             RectRgn(reg2, r2);
  175.             DiffRgn(reg1, reg2, reg1);
  176.             CopyBits(gSAT.offScreen.port^.portBits, gSAT.wind.port^.portBits, gSAT.offScreen.port^.portRect, gSAT.offScreen.port^.portRect, srcCopy, reg1);
  177.             r1 := r2;
  178.         until amount >= ticks;
  179.         DisposeRgn(reg1);
  180.         DisposeRgn(reg2);
  181.     end; {WipeIn}
  182.  
  183.     procedure WipeOut;
  184.         var
  185.             i: Integer;
  186.             reg1, reg2: RgnHandle;
  187.             r1, r2: Rect;
  188.             startTicks, amount: Longint;
  189.         const
  190.             kWipeSteps = 10;
  191.     begin
  192.         SATSetPortScreen;
  193.         reg1 := NewRgn;
  194.         reg2 := NewRgn;
  195.         startTicks := TickCount;
  196.         SetRect(r1, gSAT.offSizeH div 2, gSAT.offSizeV div 2, gSAT.offSizeH div 2, gSAT.offSizeV div 2);
  197.         repeat
  198.             amount := TickCount - startTicks;
  199.             if amount > ticks then
  200.                 amount := ticks;
  201.  
  202.             r2.left := gSAT.offSizeH div 2 - amount * Longint(gSAT.offSizeH) div 2 div ticks;
  203.             r2.right := gSAT.offSizeH - r2.left;
  204.             r2.top := gSAT.offSizeV div 2 - amount * Longint(gSAT.offSizeV) div 2 div ticks;
  205.             r2.bottom := gSAT.offSizeV - r2.top;
  206.  
  207.             RectRgn(reg1, r1);
  208.             RectRgn(reg2, r2);
  209.             DiffRgn(reg2, reg1, reg1);
  210.             CopyBits(gSAT.offScreen.port^.portBits, gSAT.wind.port^.portBits, gSAT.offScreen.port^.portRect, gSAT.offScreen.port^.portRect, srcCopy, reg1);
  211.             r1 := r2;
  212.         until amount >= ticks;
  213.         DisposeRgn(reg1);
  214.         DisposeRgn(reg2);
  215.     end; {WipeOut}
  216.  
  217.     procedure CopyScreen (fromScreen, toScreen: SATPort);
  218.         var
  219.             savePort: SATPort;
  220.     begin
  221.         SATGetPort(savePort);
  222.         SATSetPort(toScreen);
  223.         CopyBits(fromScreen.port^.portBits, toScreen.port^.portBits, fromScreen.bounds, toScreen.bounds, srcCopy, nil);
  224.         SATSetPort(savePort);
  225.     end; {CopyScreen}
  226.  
  227.     procedure ZoomRects (fromRect, toRect: Rect);
  228.         const
  229.             kNumSteps = 10;
  230.             kFrameTime = 2;
  231.         var
  232.             r: Rect;
  233.             finalTicks: Longint;
  234.             i: Longint;
  235.     begin
  236.         SATSetPortScreen;
  237.  
  238.         PenMode(patXor);
  239.         FrameRect(fromRect);
  240.         r := fromRect;
  241.         for i := 0 to kNumSteps do
  242.             begin
  243.                 Delay(kFrameTime, finalTicks);
  244.                 FrameRect(r);
  245.                 r.top := (fromRect.top * (kNumSteps - i) + toRect.top * i) div kNumSteps;
  246.                 r.left := (fromRect.left * (kNumSteps - i) + toRect.left * i) div kNumSteps;
  247.                 r.bottom := (fromRect.bottom * (kNumSteps - i) + toRect.bottom * i) div kNumSteps;
  248.                 r.right := (fromRect.right * (kNumSteps - i) + toRect.right * i) div kNumSteps;
  249.                 FrameRect(r);
  250.             end;
  251.         FrameRect(toRect);
  252.  
  253.         PenMode(patCopy);
  254.     end; {ZoomRects}
  255.  
  256.  
  257. {********* Faces ********}
  258.  
  259. {Copy srcFace to destFace. Create destFace if necessary.}
  260.     procedure SATDupFace (var destFace: FacePtr; srcFace: FacePtr);
  261.         var
  262.             savePort: SATPort;
  263.     begin
  264.         SATGetPort(savePort);
  265.  
  266.         if destFace = nil then
  267.             destFace := SATNewFace(srcFace^.iconMask.bounds);
  268.         SATSetPortFace(destFace);
  269.         SATSetPortFace2(srcFace);
  270.         CopyBits(gSAT.iconPort2.port^.portBits, gSAT.iconPort.port^.portBits, srcFace^.iconMask.bounds, srcFace^.iconMask.bounds, srcCopy, nil);
  271.         SATSetPortMask(destFace);
  272.         CopyBits(srcFace^.iconMask, destFace^.iconMask, srcFace^.iconMask.bounds, srcFace^.iconMask.bounds, srcCopy, nil);
  273.         SATChangedFace(destFace);
  274.         SATSetPort(savePort);
  275.     end; {SATDupFace}
  276.  
  277. {********* Patterns och cursors ********}
  278.  
  279.     function SATGetPattern (patID: Integer): PixPatHandle;
  280.         var
  281.             hPixPat: PixPatHandle;
  282.     begin
  283.         hPixPat := nil;
  284.  
  285.         if gSAT.colorFlag then
  286.             hPixPat := GetPixPat(patID);
  287.         if hPixPat = nil then
  288.             hPixPat := PixPatHandle(GetPattern(patID));
  289.         if hPixPat = nil then
  290.             hPixPat := PixPatHandle(GetResource('ppat', patID));
  291.  
  292.         SATGetPattern := hPixPat;
  293.     end; {SATGetPattern}
  294.  
  295.     procedure SATForePattern (pat: PixPatHandle);
  296.     begin
  297.         if pat = nil then
  298.             Exit(SATForePattern);
  299.         if GetHandleSize(Handle(pat)) = 8 then
  300.             PenPat(PatHandle(pat)^^)
  301.         else if gSAT.colorFlag then
  302.             PenPixPat(pat)
  303.         else
  304.             PenPat(pat^^.pat1Data);
  305.     end; {SATForePattern}
  306.  
  307.     procedure SATBackPattern (pat: PixPatHandle);
  308.     begin
  309.         if pat = nil then
  310.             Exit(SATBackPattern);
  311.         if GetHandleSize(Handle(pat)) = 8 then
  312.             BackPat(PatHandle(pat)^^)
  313.         else if gSAT.colorFlag then
  314.             BackPixPat(pat)
  315.         else
  316.             BackPat(pat^^.pat1Data);
  317.     end; {SATBackPattern}
  318.  
  319.     procedure SATFillRect (r: Rect; pat: PixPatHandle);
  320.     begin
  321.         SATForePattern(pat);
  322.         PaintRect(r);
  323. {$IFC UNDEFINED THINK_PASCAL}
  324.         PenPat(qd.black);        {Borde egentligen återställa!}
  325. {$ELSEC}
  326.         PenPat(black);        {Borde egentligen återställa!}
  327. {$ENDC}
  328.     end; {SATFillRect}
  329.  
  330.     procedure SATDisposePattern (pat: PixPatHandle);
  331.     begin
  332. {$IFC UNDEFINED THINK_PASCAL}
  333. {PenPat(qd.black);        {Borde egentligen återställa!}
  334. {$ELSEC}
  335. {PenPat(black);        {Borde egentligen återställa!}
  336. {$ENDC}
  337.         if pat = nil then
  338.             Exit(SATDisposePattern);
  339.         if (GetHandleSize(Handle(pat)) = 8) or (not gSAT.colorFlag) then
  340.             ReleaseResource(Handle(pat))
  341.         else
  342.             DisposePixPat(pat); {DisposPixPat}
  343.     end; {SATDisposePattern}
  344.  
  345. {Color cursor glue.}
  346. {UNTESTED!}
  347.  
  348.     function SATGetCursor (id: Integer): CursHandle;
  349.         var
  350.             curs: CursHandle;
  351.     begin
  352.         curs := nil;
  353.         if gSAT.colorFlag then
  354.             curs := CursHandle(GetCCursor(id));
  355.         if curs = nil then
  356.             begin
  357.                 curs := GetCursor(id);
  358.                 if curs <> nil then
  359.                     HLock(Handle(curs));
  360.             end;
  361.         SATGetCursor := curs;
  362.     end; {SATGetCursor}
  363.  
  364.     procedure SATSetCursor (curs: CursHandle);
  365.         var
  366.             cp: CursPtr;
  367.             ccr: CCrsrHandle;
  368.     begin
  369.         if curs = nil then
  370.             Exit(SATSetCursor);
  371. {68 bytes: old-style cursor}
  372. {96 bytes: CCrsr}
  373.         if GetHandleSize(Handle(curs)) <= 68 then
  374.             SetCursor(curs^^)
  375.         else if gSAT.colorFlag then
  376.             SetCCursor(CCrsrHandle(curs))
  377.         else
  378.             begin
  379.                 ccr := CCrsrHandle(curs);
  380.                 cp := CursPtr(@ccr^^.crsr1data);
  381.                 SetCursor(cp^);
  382.             end;
  383.     end; {SATSetCursor}
  384.  
  385.     procedure SATDisposeCursor (curs: CursHandle);
  386.     begin
  387.         if curs = nil then
  388.             Exit(SATDisposeCursor);
  389.         if GetHandleSize(Handle(curs)) <= 68 then
  390.             ReleaseResource(Handle(curs))
  391.         else
  392.             DisposeCCursor(CCrsrHandle(curs));    {DisposCCursor}
  393.     end; {SATDisposeCursor}
  394.  
  395. end.